2/*********************************************************************************************************************************
    3This file represents the event decription written by the user.
    4
    5Available predicates:
    6-happensAt(E, T) represents a time-point T in which an event E occurs. 
    7-holdsFor(U, L) represents the list L of the maximal intervals in which a U holds. 
    8-holdsAt(U, T) representes a time-point in which U holds. holdsAt may be used only in the body of a rule.
    9-initially(U) expresses the value of U at time 0. 
   10-initiatedAt(U, T) states the conditions in which U is initiated. initiatedAt may be used only in the head of a rule.
   11-terminatedAt(U, T) states the conditions in which U is terminated. terminatedAt may be used only in the head of a rule.
   12
   13For backward compatibility the following predicates are also allowed:
   14
   15-initiates(E, U, T) states that the occurrence of event E at time T initiates a period of time for which U holds. initiates may be used only in the head of a rule.
   16-terminates(E, U, T) states that the occurrence of event E at time T terminates a period of time for which U holds. terminates may be used only in the head of a rule.
   17
   18NOTE:
   19-The optimisation checks in the statically determined fluent definitions are optional.
   20**********************************************************************************************************************************/
   21
   22/*********************************** CAVIAR CE DEFINITIONS *************************************/
   23
   24/****************************************
   25 *		  CLOSE 		*
   26 ****************************************/
   27
   28holdsFor(close(Id1,Id2,24)=true, I) :-
   29	holdsFor(distance(Id1,Id2,24)=true, I).
   30
   31holdsFor(close(Id1,Id2,25)=true, I) :-
   32	holdsFor(close(Id1,Id2,24)=true, I1),
   33	holdsFor(distance(Id1,Id2,25)=true, I2),
   34	union_all([I1,I2], I).
   35
   36holdsFor(close(Id1,Id2,30)=true, I) :-
   37	holdsFor(close(Id1,Id2,25)=true, I1),
   38	holdsFor(distance(Id1,Id2,30)=true, I2),
   39	union_all([I1,I2], I).
   40
   41holdsFor(close(Id1,Id2,34)=true, I) :-
   42	holdsFor(close(Id1,Id2,30)=true, I1),
   43	holdsFor(distance(Id1,Id2,34)=true, I2),
   44	union_all([I1,I2], I).
   45
   46holdsFor(close(Id1,Id2,Threshold)=false, I) :-
   47	holdsFor(close(Id1,Id2,Threshold)=true, I1),
   48	complement_all([I1], I).
   49
   50% this is a variation of close 
   51
   52holdsFor(closeSymmetric(Id1,Id2,Threshold)=true, I) :-
   53	holdsFor(close(Id1,Id2,Threshold)=true, I1),
   54	holdsFor(close(Id2,Id1,Threshold)=true, I2),
   55	union_all([I1,I2], I).
   56
   57
   58/****************************************************************
   59 *		     PERSON					*
   60 ****************************************************************/
   61
   62initiatedAt(person(Id)=true, T) :-
   63	happensAt(start(walking(Id)=true), T),
   64	\+ happensAt(disappear(Id), T).
   65
   66initiatedAt(person(Id)=true, T) :-
   67	happensAt(start(running(Id)=true), T),
   68	\+ happensAt(disappear(Id), T).
   69
   70initiatedAt(person(Id)=true, T) :-
   71	happensAt(start(active(Id)=true), T),
   72	\+ happensAt(disappear(Id), T).
   73
   74initiatedAt(person(Id)=true, T) :-
   75	happensAt(start(abrupt(Id)=true), T),
   76	\+ happensAt(disappear(Id), T).
   77
   78initiatedAt(person(Id)=false, T) :-
   79	happensAt(disappear(Id), T).
   80
   81
   82/****************************************************************
   83 *		     LEAVING OBJECT				*
   84 ****************************************************************/
   85
   86% ----- initiate leaving_object
   87
   88initiatedAt(leaving_object(Person,Object)=true, T) :-
   89	happensAt(appear(Object), T), 
   90	holdsAt(inactive(Object)=true, T),
   91	holdsAt(person(Person)=true, T),
   92	% leaving_object is not symmetric in the pair of ids
   93	% and thus we need closeSymmetric here as opposed to close 
   94	holdsAt(closeSymmetric(Person,Object,30)=true, T).
   95
   96% ----- terminate leaving_object: pick up object
   97
   98initiatedAt(leaving_object(_Person,Object)=false, T) :-
   99	happensAt(disappear(Object), T).
  100
  101
  102/****************************************************************
  103 *		     MEETING					*
  104 ****************************************************************/
  105
  106% ----- initiate meeting
  107
  108initiatedAt(meeting(P1,P2)=true, T) :-
  109	happensAt(start(greeting1(P1,P2)=true), T),	
  110	\+ happensAt(disappear(P1), T),
  111	\+ happensAt(disappear(P2), T).
  112
  113initiatedAt(meeting(P1,P2)=true, T) :-
  114	happensAt(start(greeting2(P1,P2)=true), T),	
  115	\+ happensAt(disappear(P1), T),
  116	\+ happensAt(disappear(P2), T).
  117
  118% greeting1 
  119
  120holdsFor(greeting1(P1,P2)=true, I) :-
  121	holdsFor(activeOrInactivePerson(P1)=true, IAI),
  122	% optional optimisation check
  123	\+ IAI=[],
  124	holdsFor(person(P2)=true, IP2),
  125	% optional optimisation check	
  126	\+ IP2=[],
  127	holdsFor(close(P1,P2,25)=true, IC),
  128	% optional optimisation check
  129	\+ IC=[],  
  130	intersect_all([IAI, IC, IP2], ITemp),
  131	% optional optimisation check
  132	\+ ITemp=[], !,
  133	holdsFor(running(P2)=true, IR2),
  134	holdsFor(abrupt(P2)=true, IA2),
  135	relative_complement_all(ITemp, [IR2,IA2], I).
  136
  137% the rule below is the result of the above optimisation checks
  138holdsFor(greeting1(_P1,_P2)=true, []).
  139
  140% greeting2
  141
  142holdsFor(greeting2(P1,P2)=true, I) :-
  143	% if P1 were active or inactive 
  144	% then meeting would have been initiated by greeting1	
  145	holdsFor(walking(P1)=true, IW1),
  146	% optional optimisation check
  147	\+ IW1=[],
  148	holdsFor(activeOrInactivePerson(P2)=true, IAI2),
  149	% optional optimisation check
  150	\+ IAI2=[],
  151	holdsFor(close(P2,P1,25)=true, IC),
  152	% optional optimisation check	
  153	\+ IC=[], !,
  154	intersect_all([IW1, IAI2, IC], I).
  155
  156% the rule below is the result of the above optimisation checks
  157holdsFor(greeting2(_P1,_P2)=true, []).
  158
  159% activeOrInactivePersion 
  160
  161holdsFor(activeOrInactivePerson(P)=true, I) :-
  162	holdsFor(active(P)=true, IA),
  163	holdsFor(inactive(P)=true, In),
  164	holdsFor(person(P)=true, IP),
  165	intersect_all([In,IP], InP),
  166	union_all([IA,InP], I).
  167
  168
  169% ----- terminate meeting
  170
  171% run
  172initiatedAt(meeting(P1,_P2)=false, T) :-
  173	happensAt(start(running(P1)=true), T).
  174
  175initiatedAt(meeting(_P1,P2)=false, T) :-
  176	happensAt(start(running(P2)=true), T).
  177
  178% move abruptly
  179initiatedAt(meeting(P1,_P2)=false, T) :-
  180	happensAt(start(abrupt(P1)=true), T).
  181
  182initiatedAt(meeting(_P1,P2)=false, T) :-
  183	happensAt(start(abrupt(P2)=true), T).
  184
  185% move away from each other
  186initiatedAt(meeting(P1,P2)=false, T) :-
  187	happensAt(start(close(P1,P2,34)=false), T).
  188
  189
  190/****************************************************************
  191 *		     MOVING					*
  192 ****************************************************************/
  193
  194holdsFor(moving(P1,P2)=true, MI) :-
  195	holdsFor(walking(P1)=true, WP1),
  196	holdsFor(walking(P2)=true, WP2),
  197	intersect_all([WP1,WP2], WI),
  198	% optional optimisation check
  199	\+ WI=[], 
  200	holdsFor(close(P1,P2,34)=true, CI),
  201	% optional optimisation check
  202	\+ CI=[], !,
  203	intersect_all([WI,CI], MI).
  204
  205% the rule below is the result of the above optimisation checks
  206holdsFor(moving(_P1,_P2)=true, []).
  207
  208
  209/****************************************************************
  210 *		     FIGHTING					*
  211 ****************************************************************/
  212
  213holdsFor(fighting(P1,P2)=true, FightingI) :-
  214	holdsFor(abrupt(P1)=true, AbruptP1I),
  215	holdsFor(abrupt(P2)=true, AbruptP2I),
  216	union_all([AbruptP1I,AbruptP2I], AbruptI),
  217	% optional optimisation check
  218	\+ AbruptI=[],
  219	holdsFor(close(P1,P2,24)=true, CloseI),
  220	% optional optimisation check
  221	\+ CloseI=[],
  222	intersect_all([AbruptI,CloseI], AbruptCloseI),
  223	% optional optimisation check	
  224	\+ AbruptCloseI=[], !,
  225	holdsFor(inactive(P1)=true, InactiveP1I),
  226	holdsFor(inactive(P2)=true, InactiveP2I),
  227	union_all([InactiveP1I,InactiveP2I], InactiveI),
  228	relative_complement_all(AbruptCloseI, [InactiveI], FightingI).
  229
  230% the rule below is the result of the above optimisation checks
  231holdsFor(fighting(_P1,_P2)=true, [])